home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
langwn23.zip
/
SAMPLE01.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-03-20
|
38KB
|
1,240 lines
'============================================================================
'============================================================================
' sample code 01 to demonstrate techniques for using LangWin.
' hit Shift+F5 to run this code.
' follow instructions displayed in each sample window.
' you must start QuickBASIC as follows: qb /ah /L langwin
' /L langwin parameter provides access to LangWin quicklib
' /ah parameter is needed to allow dynamic arrays > 64k.
' hit F2, then select one of the demo subroutines to examine sample code
' subroutines called to display sample windows
DECLARE SUB demo1 ()
DECLARE SUB demo2 ()
DECLARE SUB demo3 ()
DECLARE SUB demo4 ()
DECLARE SUB demo5 ()
DECLARE SUB demo6 ()
DECLARE FUNCTION VidType% () ' used to determine type of monitor
' must compile with qb /ah /L langwin
'$DYNAMIC make all arrays dynamic
DEFINT A-Z
'$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin.
' NOTE: LANGWIN.BI contains all definitions found
' in QB.BI, so include for QB.BI is not needed.
CLEAR , , 5000 ' set stack at 5000 bytes
'---------------------------------------------------------------
' first see if EGA or VGA monitor
mm = VidType
IF mm <> 3 AND mm <> 4 THEN
' monitor is not EGA/VGA
' take whatever actions necessary (error messages)
BEEP
PRINT "LangWin needs EGA or VGA, sorry ........"
END
END IF
'-----------------------------------------------------------------
' get attribute from current screen (row 1, col 1)
' so it can be restored upon exit
OrigAttr = SCREEN(1, 1, 1)
'-------------------------------------------------------------------
' if WIDTH command is used, it must be placed before call to LangWinInit
' because code in LangWinInit extracts max rows/cols from screen and saves
' in global variables. if WIDTH is used after LangWinInit, the global
' variable will not be set correctly.
WIDTH 80, 25
'----------------------------------------------------------------------
' these variables MUST be defined BEFORE call to LangWinInit.
' keep these as low as possible to conserve memory at run time.
MaxWindows = 8 ' max simultaneous open windows
MaxButtons = 30 ' max number of objects (incl lines with labels) active
MaxTextLines = 35 ' maximum number of text lines in any scrollable win
MaxTextWins = 5 ' max windows that can have scrollable text
' must be <= MaxWindows
LOCATE , , 0 ' start with hidden text cursor
'---------------------------------------------------------------------------
' LangWin only supports text mode. You MUST call the SCREEN 0 command BEFORE
' the call to LangWinInit. You can call SCREEN with a video page other than 0
' (i.e., SCREEN 0,,x,x where x is a page number supported by your system).
' Code in LangWinInit will determine which video page you are using and save
' the value in a global variable for use by other LangWin routines. If you
' call SCREEN 0 after LangWinInit and change the original video page, you'll
' get unpredictable results (i.e., LangWin will write to the original video
' page). However, you can use other video pages for functions not associated
' with your LangWin windows; just be sure to set the video page back to the
' original value defined below.
SCREEN 0, , 0, 0 ' LangWin ONLY supports text mode
' You MUST call the SCREEN command BEFORE LangWinInit
CALL LangWinInit ' initialize (if mouse exists, it will be displayed)
' if you get "subscript out of range" error while
' in this routine, be sure you called QB with /ah.
' then try reducing the value of MaxWindows.
' check the WIDTH command; reduce number of columns,
' and/or number of rows.
'-----------------------------------------------------------------------
' display "wallpaper"
IF HaveMouse THEN CALL HideMouseCursor ' first hide mouse pointer
CLS
CALL SetColor(8, 15)
FOR i = 1 TO MaxRows
LOCATE i, 1
PRINT STRING$(80, 178); ' can try 176, 177, or 178
NEXT
IF HaveMouse THEN CALL ShowMouseCursor ' display the mouse pointer
'====================================================================
CALL demo1 ' simple window
CALL demo2 ' add window with buttons
CALL demo3 ' add button that causes child window(s) to be opened
CALL demo4 ' window with input fields & child window
CALL demo5 ' scrollable text windows & child windows
CALL demo6 ' password entry technique
'=====================================================================
IF HaveMouse THEN HideMouseCursor ' we're done with the mouse
bbb = (OrigAttr AND &HF0) \ 16 ' mask & shift to get original background
fff = OrigAttr AND &HF ' mask to get original foreground
PALETTE ' restore original palette
CALL SetColor(fff, bbb) ' restore orig foreground/background
CLS
LOCATE , , 1 ' make text cursor visible
END
REM $STATIC
'
' one window opened; it contains info text only.
' no scrollable text, no buttons.
' only valid event is 'close'
' (window can be moved).
'
SUB demo1
'=================================================
' first window: info text only (w1 contains window's number or error code)
w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
' test to see if window was successfully opened
IF w1 < 0 THEN
' some code to handle the error
CLS
PRINT "w1 BlankWin error number: "; w1
END
END IF
' display some text in the window
d = ShowWinText(2, 2, 0, "Close window to exit")
d = ShowWinText(3, 2, 0, "(double click top/left).")
d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
' put a title in window
d = ShowTitle("Info Only Window", 15, 1)
' no error tests will be made for above functions
'=============================================================
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE w1 ' first window
' now determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
xx = CloseWindow
CASE 2 ' text
' no scrollable text to select in this win
' this case could be omitted
CASE 3 ' button
' no buttons in this win
' this case could be omitted
END SELECT
END SELECT
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
'
' this demo adds to the code developed for demo1
'
' two windows opened:
' the first has info text only.
' the second has two buttons:
' 1) beep; 2) exit
'
SUB demo2
'=================================================
' first window: info text only (w1 contains window's number or error code)
w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
' test to see if window was successfully opened
IF w1 < 0 THEN
' some code to handle the error
CLS
PRINT "w1 BlankWin error number: "; w1
END
END IF
' display some text in the window
d = ShowWinText(2, 2, 0, "Close window to exit")
d = ShowWinText(3, 2, 0, "(double click top/left).")
d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
' put a title in window
d = ShowTitle("Info Only Window", 15, 1)
' no error tests will be made for above functions
'=============================================================
' second window: text and buttons (w2 contains window's number or error code)
w2 = BlankWin(9, 26, 21, 66, 9, 15, 1, 0, 0, 1)
' test to see if window was successfully opened
IF w2 < 0 THEN
' some code to handle the error
CLS
PRINT "w2 BlankWin error number: "; w2
END
END IF
' display some text in the window
d = ShowWinText(1, 2, 15, "Click button to exit.")
d = ShowWinText(2, 2, 15, "Drag top/left to move.")
' put a title in window
d = ShowTitle("Window With Buttons", 15, 6)
' no error tests will done for above functions
' make buttons.
' save handle numbers in variables.
' these will be used later to determine which button was clicked.
beep2 = MakePushButton(7, 10, 6, "BEEP", 15, 3, 1)
xit2 = MakePushButton(10, 10, 6, "EXIT", 15, 4, 1)
' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure
CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus
'=============================================================
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE w1 ' first window
' now determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
xx = CloseWindow
CASE 2 ' text
' no scrollable text to select in this win
CASE 3 ' button
' no buttons in this win
END SELECT
CASE w2 ' second window
' now determine what type of event occurred in the window w2
SELECT CASE action
CASE 1 ' close
' even though window has no close icon,
' ESC will generate a close event.
' we will ignore the close event
' since win has specific EXIT button.
CASE 2 ' text
' no scrollable text to select in this win
CASE 3 ' button
' determine which button was clicked
' get handle number of clicked button
ButtonHandle = WinParms(CurWinPtr, 16)
' test all buttons for match
SELECT CASE ButtonHandle
CASE xit2 ' exit
xx = CloseWindow
CASE beep2 ' beep
BEEP
END SELECT
END SELECT
END SELECT
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
'
' this demo adds to the code developed for demos 1 & 2.
'
' two windows opened:
' the first has info text only.
' the second has three buttons:
' 1) beep; 2) exit; 3) open a new child (subordinate) window
' 4) sample error window
'
' only one child window can be open at a time.
' once the third button is clicked and a child window
' is open, the button is de-activated and cleared.
' after the user closes the child window, the button will be re-activated.
'
' similarly, the second button (exit) cannot be selected while a child
' window is open.
'
' in theory, if you have an event (ie button or text) that causes another
' window to be open, the user of your program could continue to click the
' button (or text) opening windows until the MaxWindows limit is reached.
' each window that is open will be given a unique window number.
' since the WinEvent loop must account for every open window number,
' this could result in long and complex code
' (although the same code segments could be used to handle
' events for different window numbers). in any case, this demo
' shows code that can be used to restrict the number of child
' windows that can be opened dynamically (ie by user selecting a button
' or text event at run time).
'
' this code also shows examples of how one can prevent a parent window
' from being closed while child (subordinate) windows are still open.
'
' if the fourth button is clicked, a modal error window is opened
' (a modal window is one that will retain focus, regardless of
' any events/clicks, until it is closed). in the example, the error
' window contains some error text, and
' requires the user to click an "OK" button before any
' more processing will be done. if the user clicks on any other
' window or button, it will be ignored
' until the "OK" button in the error window is clicked.
' in practice, the modal error window could result
' from an invalid button click (not allowed at that point),
' or an erroneous entry/selection by the user.
'
SUB demo3
'=================================================
' first window: info text only (w1 contains window's number or error code)
w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
' test to see if window was successfully opened
IF w1 < 0 THEN
' some code to handle the error
CLS
PRINT "w1 BlankWin error number: "; w1
END
END IF
' display some text in the window
d = ShowWinText(2, 2, 0, "Close window to exit")
d = ShowWinText(3, 2, 0, "(double click top/left).")
d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
' put a title in window
d = ShowTitle("Info Only Window", 15, 1)
' no error tests will be made for above functions
'=============================================================
' second window: text and buttons (w2 contains window's number or error code)
w2 = BlankWin(9, 26, 21, 66, 9, 15, 1, 0, 0, 1)
' test to see if window was successfully opened
IF w2 < 0 THEN
' some code to handle the error
CLS
PRINT "w2 BlankWin error number: "; w2
END
END IF
' display some text in the window
d = ShowWinText(1, 2, 15, "Click button to exit.")
d = ShowWinText(2, 2, 15, "Drag top/left to move.")
d = ShowWinText(3, 2, 15, "Click button to open new win")
d = ShowWinText(4, 2, 15, "Click button to open error win")
' put a title in window
d = ShowTitle("Window With Buttons", 15, 6)
' no error tests will done for above functions
' make buttons.
' save handle numbers in variables.
' these will be used later to determine which button was clicked.
beep2 = MakePushButton(7, 10, 6, "BEEP", 15, 3, 1)
xit2 = MakePushButton(10, 10, 6, "EXIT", 15, 4, 1)
new2 = MakePushButton(10, 20, 9, "New Win", 15, 2, 1)
errorb = MakePushButton(7, 20, 7, "ERROR", 15, 5, 1)
' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure
CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus
'=============================================================
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE w1 ' first window
' now determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
xx = CloseWindow
CASE 2 ' text
' no scrollable text to select in this win
CASE 3 ' button
' no buttons in this win
END SELECT
CASE w2 ' second window
' now determine what type of event occurred in the window w2
SELECT CASE action
CASE 1 ' close
' even though window has no close icon,
' ESC will generate a close event.
' i'll choose to ignore the close event
' since this win has specific EXIT button.
' so, there will be no call to CloseWindow here
CASE 2 ' text
' no scrollable text to select in this win
CASE 3 ' button
' determine which button was clicked
' get handle number of clicked button
ButtonHandle = WinParms(CurWinPtr, 16)
' test all buttons for match
SELECT CASE ButtonHandle
CASE xit2 ' exit
xx = CloseWindow
CASE beep2 ' beep
BEEP
CASE new2 ' open a new child window
' first deactivate (clear) the "new win" & "exit" buttons.
' this code should be placed before child window is opened
' to insure that window with buttons is active
' (thus the FocusSw parm can be 0)
d = DeactivateButton(new2, 0)
d = DeactivateButton(xit2, 0)
' open a child window
w3a = BlankWin(3, 46, 10, 74, 6, 15, 1, 0, 1, 1)
' test to see if window was successfully opened
IF w3a < 0 THEN
' some code to handle the error
CLS
PRINT "w3a BlankWin error number: "; w3a
END
END IF
' put some text into the window
d = ShowWinText(1, 2, 15, "Child WIndow")
CASE errorb ' error button
' open a modal error window
' that is, no other window is processed until
' this modal window is closed
erwin = BlankWin(10, 6, 19, 36, 5, 15, 1, 0, 0, 2)
' test to see if window was successfully opened
IF erwin < 0 THEN
' some code to handle the error
CLS
PRINT "erwin BlankWin error number: "; erwin
END
END IF
' put some text into the window
d = ShowWinText(2, 3, 14, "Sample Error Window")
d = ShowWinText(4, 3, 15, "All events ignored until")
d = ShowWinText(5, 3, 15, "you click OK to continue")
ok3 = MakePushButton(7, 10, 4, "OK", 15, 3, 1)
END SELECT ' end of select for button in window w2
END SELECT ' end of select for window w2
CASE w3a
' determine what type of event occurred in the window w3a
SELECT CASE action
CASE 1 ' close
xx = CloseWindow ' close the window
' re-activate new-win and exit buttons
' and leave focus in window containing the buttons
d = ActivateButton(new2, 0)
d = ActivateButton(xit2, 0)
CASE 2 ' text
' no scrollable text to select in this win
CASE 3 ' button
' no buttons in this win
END SELECT
CASE erwin ' the error window
' only valid action in this window a button click,
' and only valid button is the ok button to close
' so i'll just close the window if anything happens.
xx = CloseWindow
END SELECT
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
'
'
' open a plain window with input fields and two buttons: EXIT & SHOW.
'
' user updates input field and clicks on "SHOW" button to display fields
' in a new window. while this child window is open,
' neither the SHOW or EXIT buttons are active (in addition, the
' contents of these buttons are cleared to remind user they are
' not active).
'
' when sub window is closed, the EXIT and SHOW buttons are again displayed
' and will be active.
'
SUB demo4
' open a plain window (no scrollable text, close icon)
w1 = BlankWin(3, 3, 21, 60, 9, 15, 2, 0, 1, 1)
' test to see if window was successfully opened
IF w1 < 0 THEN
' some code to handle the error
CLS
PRINT "w1 BlankWin error: "; w1
END
END IF
' display some text in the window
d = ShowWinText(2, 2, 15, "Name:")
d = ShowWinText(4, 2, 15, "Address:")
d = ShowWinText(6, 2, 15, "City:")
d = ShowWinText(8, 2, 15, "State:")
d = ShowWinText(10, 2, 15, "Zip Code:")
d = ShowWinText(12, 5, 14, "Enter data, then click on SHOW.")
d = ShowWinText(13, 2, 14, "(CANNOT close this window if SHOW window is open.)")
d = ShowWinText(14, 2, 14, "(CANNOT click on SHOW if SHOW window is already open.)")
' make input fields
' save the handles in variables.
' these will be used later to extract contents of input fields.
nam = MakeInputField(2, 12, 25, "", 14, 1)
addr = MakeInputField(4, 12, 25, "", 14, 1)
city = MakeInputField(6, 12, 25, "", 14, 1)
state = MakeInputField(8, 12, 25, "", 14, 1)
zip = MakeInputField(10, 12, 25, "", 14, 1)
' make buttons.
' save handle numbers in variables.
' these will be used later to determine which button was clicked.
sho = MakePushButton(16, 20, 6, "SHOW", 15, 4, 1)
xit = MakePushButton(16, 10, 6, "EXIT", 15, 4, 1)
' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
WinParms(CurWinPtr, 16) = xit' put handle of exit button into data structure
CALL ChangeButtonFocus(xit, 0) ' reverse video the button to give it focus
' put a title in window
d = ShowTitle("Window With Input Fields", 15, 4)
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE w1 ' main window
' now determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
' before we can close main window (w1),
' make sure child window (w2) is not open.
IF NOT IsWinOpen(w2, wh) THEN xx = CloseWindow
CASE 2 ' scrollable text
' there is no scrollable text, ignore this event
CASE 3 ' button click
' lets see which button was clicked (if we had more than 1 button)
' get handle number of clicked button
ButtonHandle = WinParms(CurWinPtr, 16)
' test all buttons for match
SELECT CASE ButtonHandle
CASE xit ' exit
xx = CloseWindow
CASE sho ' show button
' first, clear the show and exit buttons to
' deactivate them.
' this code should be placed before child window is opened
' to insure that window with buttons is active
' (thus the FocusSw parm can be 0)
d = DeactivateButton(sho, 0)
d = DeactivateButton(xit, 0)
' open a child window and display all input fields
' contents of all fields are in ButtonsText(handle).
' just use handle of each input field
' (returned by MakeInputField) to extract field contents.
w2 = BlankWin(5, 43, 15, 73, 4, 15, 1, 0, 1, 1)
' see if win opened successfully
IF w2 < 0 THEN
' code to handle failure of window to open
CLS
PRINT "w2 BlankWin error code: "; w2
END
END IF
' display title and contents of input fields
d = ShowWinText(2, 2, 15, ButtonsText(nam))
d = ShowWinText(3, 2, 15, ButtonsText(addr))
d = ShowWinText(4, 2, 15, ButtonsText(city))
d = ShowWinText(5, 2, 15, ButtonsText(state))
d = ShowWinText(6, 2, 15, ButtonsText(zip))
d = ShowWinText(8, 2, 11, "CANNOT click on SHOW")
d = ShowWinText(9, 2, 11, "while this window is open.")
d = ShowTitle("INPUT FIELDS", 15, 1)
END SELECT
END SELECT
CASE w2 ' child window
' now determine what type of event occurred in the window w2
SELECT CASE action
CASE 1 ' close
xx = CloseWindow ' close sub window (w2)
' now redisplay show and exit buttons
' and leave focus in window containing the buttons
d = ActivateButton(sho, 0)
d = ActivateButton(xit, 0)
CASE 2 ' text
' no scrollable text to select in this win
' this case could be omitted
CASE 3 ' button
' no buttons in this win
' this case could be omitted
END SELECT
END SELECT
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
'
' open two windows with scrollable text and buttons
'
' user clicks on a line in the scrollable text;
' a child window will be opened and the selected text line displayed
' in an input field.
'
' only one child window for each original scrollable text window
' will be allowed.
'
' clicking on a new line in scrollable text while child window is open
' will cause new line to be displayed in the child window's input field.
'
' closing scrollable text window while a child window is open
' will first cause child window to be closed.
'
SUB demo5
' create a string array to hold scrollable text
DIM Text(1 TO 30) AS STRING
' create some scrollable text
' entire array not filled, trailing null entries will not be displayed
FOR i = 1 TO 25
Text(i) = "Window 1 - Line " + STR$(i)
NEXT
' open a window with scrollable text
w1 = OpenScrollWindow(3, 3, 21, 25, 3, 15, 2, 15, Text(), 4, 2, 14, 20, 0, 1)
ERASE Text ' to save space
' test to see if window was successfully opened
IF w1 < 0 THEN
' some code to handle the error
CLS
PRINT "w1 OpenScrollWindow error: "; w1
END
END IF
' put a vertical line in window and some text
d = MakeHorizLine(15, 2)
d = MakeHorizLine(3, 2)
d = ShowWinText(2, 3, 14, "Double click text")
' no checking for error return codes was done for above calls
' make buttons.
' save handle numbers in variables.
' these will be used later to determine which button was clicked.
xit1 = MakePushButton(16, 7, 6, "EXIT", 15, 4, 1)
' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
WinParms(CurWinPtr, 16) = xit1' put handle of exit button into data structure
CALL ChangeButtonFocus(xit1, 0) ' reverse video the button to give it focus
' put a title in window
d = ShowTitle("First Window", 15, 4)
'----------------------------------------------------------
' re-define array for scrollable text (different size)
REDIM Text(1 TO 20) AS STRING
FOR i = 1 TO 20
Text(i) = "Window 2 - Line " + STR$(i)
NEXT
' open a window with scrollable text
w2 = OpenScrollWindow(5, 13, 23, 35, 9, 15, 2, 15, Text(), 4, 2, 14, 20, 0, 1)
ERASE Text ' to save space
' test to see if window was successfully opened
IF w2 < 0 THEN
' some code to handle the error
CLS
PRINT "w2 OpenScrollWindow error: "; w2
END
END IF
' put a vertical line in window and some text
d = MakeHorizLine(15, 2)
d = MakeHorizLine(3, 2)
d = ShowWinText(2, 3, 14, "Double click text")
' no checking for error return codes was done for above calls
' make buttons.
' save handle numbers in variables.
' these will be used later to determine which button was clicked.
xit2 = MakePushButton(16, 7, 6, "EXIT", 15, 4, 1)
' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure
CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus
' put a title in window
d = ShowTitle("Second Window", 15, 4)
'------------------------------------------------------------
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE w1 ' first window
' determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
' first see if a child window (w1s) is open.
' if it is, IsWinOpen will return handle.
IF NOT IsWinOpen(w1s, Han) THEN
xx = CloseWindow ' sub win not open, close scrollable win
ELSE ' sub win is open
zz = CurWinPtr ' save handle of current scrollable win
CALL NewFocusWindow(Han) ' make sub win current
xx = CloseWindow ' close it
CALL NewFocusWindow(zz) ' make scrollable win current
xx = CloseWindow ' close it
END IF
CASE 2 ' text
' save pointer to selected text line
TextLine = WinParms(CurWinPtr, 15)
' save index in SaveText array where text is saved
ArrayIndex = WinParms(CurWinPtr, 18)
' if no child win already open,
' then open one and display selected text
' IsWinOpen returns handle of window number if it's open
IF NOT IsWinOpen(w1s, Han) THEN
' open a blank window
w1s = BlankWin(5, 43, 10, 73, 4, 15, 1, 0, 1, 1)
' see if win opened successfully
IF w1s < 0 THEN
' code to handle failure of window to open
END
END IF
' display title
d = ShowTitle("TEXT SELECTED - Win 1", 15, 1)
' show the text selected in the new window
t$ = SaveText(ArrayIndex, TextLine)' clicked line to be displayed
w1f = MakeInputField(2, 2, 25, t$, 0, 7)
' if child win is open, update data in it
ELSE
' use handle returned by IsWinOpen to make sub win current
CALL NewFocusWindow(Han)
' show the text selected in the new window
' put text into input field
ButtonsText(w1f) = SaveText(ArrayIndex, TextLine)
' redisplay the input field
CALL ReShowInputField(w1f)
END IF
' give focus back to window with text
CALL NewFocusWindow(w1)
CASE 3 ' button
' take advantage of fact that there is only one possible button
' (which is EXIT)
' first see if a child window (w1s) is open.
' if it is, IsWinOpen will return handle.
IF NOT IsWinOpen(w1s, Han) THEN
xx = CloseWindow ' sub win not open, close scrollable win
ELSE ' sub win is open
zz = CurWinPtr ' save handle of current scrollable win
CALL NewFocusWindow(Han) ' make sub win current
xx = CloseWindow ' close it
CALL NewFocusWindow(zz) ' make scrollable win current
xx = CloseWindow ' close it
END IF
END SELECT
CASE w2 ' second window
' determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
' first see if a child window (w2s) is open.
' if it is, IsWinOpen will return handle.
IF NOT IsWinOpen(w2s, Han) THEN
xx = CloseWindow ' sub win not open, close scrollable win
ELSE ' sub win is open
zz = CurWinPtr ' save handle of current scrollable win
CALL NewFocusWindow(Han) ' make sub win current
xx = CloseWindow ' close it
CALL NewFocusWindow(zz) ' make scrollable win current
xx = CloseWindow ' close it
END IF
CASE 2 ' text
' save pointer to selected text line
TextLine = WinParms(CurWinPtr, 15)
' save index in SaveText array where text is saved
ArrayIndex = WinParms(CurWinPtr, 18)
' if no child win already open,
' then open one and display selected text
' IsWinOpen returns handle of window number if it's open
IF NOT IsWinOpen(w2s, Han) THEN
' open a blank window
w2s = BlankWin(15, 43, 20, 73, 5, 15, 1, 0, 1, 1)
' see if win opened successfully
IF w2s < 0 THEN
' code to handle failure of window to open
END
END IF
' display title
d = ShowTitle("TEXT SELECTED - Win 2", 15, 1)
' show the text selected in the new window
t$ = SaveText(ArrayIndex, TextLine)' clicked line to be displayed
w2f = MakeInputField(2, 2, 25, t$, 0, 7)
' if child win is open, update data in it
ELSE
' use handle returned by IsWinOpen to make sub win current
CALL NewFocusWindow(Han)
' show the text selected in the new window
' put text into input field
ButtonsText(w2f) = SaveText(ArrayIndex, TextLine)
' redisplay the input field
CALL ReShowInputField(w2f)
END IF
' give focus back to window with text
CALL NewFocusWindow(w2)
CASE 3 ' button
' take advantage of fact that there is only one possible button
' (which is EXIT)
' first see if a child window (w2s) is open.
' if it is, IsWinOpen will return handle.
IF NOT IsWinOpen(w2s, Han) THEN
xx = CloseWindow ' sub win not open, close scrollable win
ELSE ' sub win is open
zz = CurWinPtr ' save handle of current scrollable win
CALL NewFocusWindow(Han) ' make sub win current
xx = CloseWindow ' close it
CALL NewFocusWindow(zz) ' make scrollable win current
xx = CloseWindow ' close it
END IF
END SELECT
CASE w1s, w2s ' child windows
' to simplify things, i'll handle both child windows
' with same code. to further simplify, i'll only allow a close event.
SELECT CASE action
CASE 1 ' close
xx = CloseWindow
END SELECT
END SELECT
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
'
' show an example of using input field for password entry.
' as text is entered, only * is displayed, but actual text is
' stored in the ButtonsText data structure.
'
' after entering password, click on button.
' a modal window will be opened and text from ButtonsText data structure
' displayed (your program would access this text to verify password).
'
'
SUB demo6
' open a plain window (no scrollable text, close icon)
w1 = BlankWin(3, 3, 15, 43, 9, 15, 2, 0, 1, 1)
' test to see if window was successfully opened
IF w1 < 0 THEN
' some code to handle the error
CLS
PRINT "w1 BlankWin error: "; w1
END
END IF
' display some text in the window
d = ShowWinText(2, 2, 14, "Select field; enter password;")
d = ShowWinText(3, 2, 14, "and click on SHOW button.")
d = ShowWinText(5, 2, 15, "Password:")
passwd = MakeInputField(5, 12, -8, "", 14, 1)
sho = MakePushButton(7, 5, 6, "SHOW", 15, 4, 1)
xit = MakePushButton(7, 22, 6, "EXIT", 15, 4, 1)
' put a title in window
d = ShowTitle("Password Entry Window", 15, 4)
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE w1 ' main window
' now determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
xx = CloseWindow
CASE 2 ' scrollable text
' there is no scrollable text, ignore this event
CASE 3 ' button click
SELECT CASE WinParms(CurWinPtr, 16)
CASE xit
xx = CloseWindow
CASE sho
' first, deactivate clear the show & exit buttons to
' this code should be placed before child window is opened
' to insure that main window with buttons is active
' (thus the FocusSw parm in DeactivateButton can be 0)
d = DeactivateButton(sho, 0)
d = DeactivateButton(xit, 0)
' open a modal child window and display the actual password
' contents are in ButtonsText(passwd).
' instead of opening a window,
' you could use contents of ButtonsText(passwd)
' to verify the password.
w2 = BlankWin(5, 33, 11, 60, 4, 15, 1, 0, 1, 2)
' see if win opened successfully
IF w2 < 0 THEN
' code to handle failure of window to open
CLS
PRINT "w2 BlankWin error code: "; w2
END
END IF
' display title and contents of input fields
d = ShowWinText(2, 2, 14, "Password:")
d = ShowWinText(2, 12, 15, ButtonsText(passwd))
d = ShowWinText(5, 2, 14, "Close to continue.")
d = ShowTitle("PASSWORD", 15, 1)
END SELECT ' end of section for buttons
END SELECT ' end of section for main window
CASE w2 ' child window with password
' now determine what type of event occurred in the window w2
SELECT CASE action
CASE 1 ' close
xx = CloseWindow ' close sub window (w2)
' now redisplay show and exit buttons
' and leave focus in window containing the buttons
d = ActivateButton(sho, 0)
d = ActivateButton(xit, 0)
CASE 2 ' text
' no scrollable text to select in this win
' this case could be omitted
CASE 3 ' button
' no buttons in this win
' this case could be omitted
END SELECT
END SELECT
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
' =====================================================
' returns type of video display
'
' return values:
' 1: black/white (could be EGA/VGA with monochrome)
' 2: CGA (with color)
' 3: EGA (with color)
' 4: VGA (with color)
' 5: MCGA (with color)
' 99: other
'
FUNCTION VidType
' quick & dirty, check &h463
DEF SEG = 0
IF PEEK(&H463) = &HB4 THEN ' see if monochrome
VidType = 1
EXIT FUNCTION
END IF
DEF SEG
' first try int 10h, function 1Ah
InRegs.ax = &H1A00
CALL INTERRUPTX(&H10, InRegs, OutRegs)
IF (OutRegs.ax AND &HFF) = &H1A THEN ' see if int 10h, funct 1Ah supported
code = (OutRegs.bx AND &HFF) ' get display code
SELECT CASE code
CASE 1 ' MDA
VidType = 1
CASE 2 ' CGA
VidType = 2
CASE 4 ' EGA color
VidType = 3
CASE 5 ' EGA b/w
VidType = 1
CASE 7 ' VGA b/w
VidType = 1
CASE 8 ' VGA color
VidType = 4
CASE 10 ' MCGA color
VidType = 5
CASE 11 ' MCGA b/w
VidType = 1
CASE ELSE
VidType = 99 ' other
END SELECT
EXIT FUNCTION
ELSE
' now try int 10h, function 12h, sub-function 10h
InRegs.ax = &H1200
InRegs.bx = &H10
CALL INTERRUPTX(&H10, InRegs, OutRegs)
IF (OutRegs.bx AND &HFF00) = 1 THEN ' see if monochrome
VidType = 1
EXIT FUNCTION
END IF
IF (OutRegs.bx AND &HFF) <> &H10 THEN ' see if BL reg changed
VidType = 3 ' EGA (not sure why it couldn't be VGA too!)
EXIT FUNCTION
END IF
VidType = 99 ' other (probably CGA or MDA)
END IF
END FUNCTION